home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / phello.zip / HELLOWIN.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-25  |  4KB  |  150 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal for Windows                     }
  4. {   Graphical Hello Windows application          }
  5. {   Copyright (c) 1991 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. program HelloWin;
  10.  
  11. uses WinProcs, WinTypes, WObjects, Strings, BitMaps;
  12.  
  13. const
  14.  
  15.   GlobeFileName = 'world%d.bmp';
  16.   GlobeCount = 32;
  17.  
  18.   HelloCount = 10;
  19.   HelloText: array[0..HelloCount - 1] of PChar = (
  20.     'Hello', 'Bonjour', 'Wilkommen', 'Konnichiwa', 'G''day!',
  21.     'Bongiorno', 'Goddag', 'Aloha!', 'Hej', 'íHola!');
  22.  
  23. type
  24.  
  25.   PGlobeWindow = ^TGlobeWindow;
  26.   TGlobeWindow = object(TWindow)
  27.     Font: HFont;
  28.     Globes: array[0..GlobeCount - 1] of HBitmap;
  29.     CurGlobe, CurText, TextCount: Integer;
  30.     Text: array[0..1] of PChar;
  31.     constructor Init;
  32.     destructor Done; virtual;
  33.     procedure GetWindowClass(var WndClass: TWndClass); virtual;
  34.     procedure SetupWindow; virtual;
  35.     procedure Paint(DC: HDC; var PS: TPaintStruct); virtual;
  36.     procedure WMTimer(var Msg: TMessage); virtual wm_First + wm_Timer;
  37.   end;
  38.  
  39.   TGlobeApp = object(TApplication)
  40.     procedure InitMainWindow; virtual;
  41.   end;
  42.  
  43. constructor TGlobeWindow.Init;
  44. var
  45.   I: Integer;
  46.   Palette: Word;
  47.   W, H: Longint;
  48.   Name: array[0..79] of Char;
  49. begin
  50.   TWindow.Init(nil, 'Hello, Windows');
  51.   Attr.W := 300;
  52.   Attr.H := 300;
  53.   Font := CreateFont(36, 0, 0, 0, fw_Normal, 0, 0, 0, ansi_CharSet,
  54.     out_Default_Precis, clip_Default_Precis, default_Quality,
  55.     variable_Pitch or ff_Roman, 'Tms Rmn');
  56.   SetCursor(LoadCursor(0, idc_Wait));
  57.   for I := 0 to GlobeCount - 1 do
  58.   begin
  59.     WVSPrintF(Name, GlobeFileName, I);
  60.     Globes[GlobeCount - I - 1] := LoadBitMapFile(Name);
  61.   end;
  62.   SetCursor(LoadCursor(0, idc_Arrow));
  63.   CurGlobe := 0;
  64.   CurText := 0;
  65.   TextCount := 0;
  66.   Text[0] := HelloText[0];
  67.   Text[1] := HelloText[1];
  68. end;
  69.  
  70. destructor TGlobeWindow.Done;
  71. var
  72.   I: Integer;
  73. begin
  74.   for I := 0 to GlobeCount - 1 do DeleteObject(Globes[I]);
  75.   DeleteObject(Font);
  76.   TWindow.Done;
  77. end;
  78.  
  79. procedure TGlobeWindow.GetWindowClass(var WndClass: TWndClass);
  80. begin
  81.   TWindow.GetWindowClass(WndClass);
  82.   WndClass.hbrBackground := CreateSolidBrush($000000);
  83. end;
  84.  
  85. procedure TGlobeWindow.SetupWindow;
  86. begin
  87.   TWindow.SetupWindow;
  88.   SetTimer(HWindow, 0, 100, nil);
  89. end;
  90.  
  91. procedure TGlobeWindow.Paint(DC: HDC; var PS: TPaintStruct);
  92. var
  93.   MemDC: HDC;
  94.   R, T: TRect;
  95.   BitMap: TBitMap;
  96. begin
  97.   GetClientRect(HWindow, R);
  98.   SelectObject(DC, Font);
  99.   SetTextColor(DC, $FFFFFF);
  100.   SetBkColor(DC, $000000);
  101.   SetTextAlign(DC, ta_Center or ta_Top);
  102.   T.left := R.left; T.right := R.right;
  103.   T.top := 10; T.bottom := 46;
  104.   ExtTextOut(DC, R.right div 2, T.top, eto_Opaque, @T,
  105.     Text[0], StrLen(Text[0]), nil);
  106.   T.top := R.bottom - 46; T.bottom := R.bottom - 10;
  107.   ExtTextOut(DC, R.right div 2, T.top, eto_Opaque, @T,
  108.     Text[1], StrLen(Text[1]), nil);
  109.   MemDC := CreateCompatibleDC(DC);
  110.   SelectObject(MemDC, Globes[CurGlobe]);
  111.   GetObject(Globes[CurGlobe], SizeOf(BitMap), @BitMap);
  112.   BitBlt(DC, (R.right - BitMap.bmWidth) div 2,
  113.     (R.bottom - BitMap.bmHeight) div 2, BitMap.bmWidth,
  114.     BitMap.bmHeight, MemDC, 0, 0, SrcCopy);
  115.   DeleteDC(MemDC);
  116. end;
  117.  
  118. procedure TGlobeWindow.WMTimer(var Msg: TMessage);
  119. var
  120.   P: PChar;
  121. begin
  122.   Inc(CurGlobe);
  123.   if CurGlobe = GlobeCount then CurGlobe := 0;
  124.   Inc(TextCount);
  125.   if TextCount = 10 then
  126.   begin
  127.     TextCount := 0;
  128.     repeat
  129.       P := HelloText[Random(HelloCount)];
  130.     until (P <> Text[0]) and (P <> Text[1]);
  131.     Text[CurText] := P;
  132.     CurText := 1 - CurText;
  133.   end;
  134.   InvalidateRect(HWindow, nil, False);
  135. end;
  136.  
  137. procedure TGlobeApp.InitMainWindow;
  138. begin
  139.   MainWindow := New(PGlobeWindow, Init);
  140. end;
  141.  
  142. var
  143.   GlobeApp: TGlobeApp;
  144.  
  145. begin
  146.   GlobeApp.Init('HelloWin');
  147.   GlobeApp.Run;
  148.   GlobeApp.Done;
  149. end.
  150.